home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
prset
/
prsetup.frm
< prev
next >
Wrap
Text File
|
1995-05-08
|
9KB
|
310 lines
VERSION 2.00
Begin Form PrintSetup
BackColor = &H00FFFF00&
BorderStyle = 3 'Fixed Double
Caption = "Printer Setup"
ClientHeight = 4200
ClientLeft = 3465
ClientTop = 2430
ClientWidth = 6495
Height = 4605
Left = 3405
LinkMode = 1 'Source
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4200
ScaleWidth = 6495
Top = 2085
Width = 6615
Begin CommandButton Command3
Caption = "Setup ..."
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4800
TabIndex = 3
Top = 3120
Width = 1575
End
Begin CommandButton Command2
Caption = "Cancel"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4800
TabIndex = 2
Top = 1440
Width = 1575
End
Begin CommandButton Command1
Caption = "OK"
Default = -1 'True
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 495
Left = 4800
TabIndex = 1
Top = 480
Width = 1575
End
Begin ListBox List1
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 3150
Left = 120
TabIndex = 0
Top = 480
Width = 4455
End
Begin Label Label2
BackColor = &H00FFFF00&
Caption = "Copyright (c) 1991 Corey Schwartz, Programmer's Warehouse 602-443-0580, 73240,2734 All Rights Reserved"
Height = 375
Left = 120
TabIndex = 5
Top = 3720
Width = 6375
End
Begin Label Label1
BackColor = &H00FFFF00&
Caption = "&Printer"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 255
Left = 120
TabIndex = 4
Top = 120
Width = 1695
End
End
Const DM_UPDATE = 1
Const DM_COPY = 2
Const DM_PROMPT = 4
Const DM_MODIFY = 8
Const SIZETEMPBUFF = 80
Const MAXKEYBUFFER = 300
Declare Function CallProc Lib "CallAddr.DLL" (ByVal fnc&, ByVal hWnd%, ByVal hDrv%, ByVal dmOut&, ByVal lpName$, ByVal lpPort$, ByVal dmIn&, ByVal lpPro As Any, ByVal wMode%) As Integer
Declare Function GetProcAddress Lib "Kernel" (ByVal hDrv%, ByVal Esc As String) As Long
Sub AccessPrinter (UpdatePrt As Integer)
Dim lpName As String
Dim lpPort As String
Dim lpDriver As String
Dim TempStr As String
Dim hMem As Integer
Dim lpfnMode As Long
Dim hDriver As Integer
Dim Flags As Integer
If List1.ListIndex = -1 Then
Exit Sub
End If
Screen.MousePointer = 11
TempStr = List1.list(List1.ListIndex)
x = lbParse(TempStr, lpName, lpPort, lpDriver)
hDriver = LoadLibrary(lpDriver)
If (hDriver >= 32) Then
lpfnMode = GetProcAddress(hDriver, "EXTDEVICEMODE")
If (lpfnMode <> 0) Then
wSizeDM = CallProc(lpfnMode, 0&, hDriver, 0&, lpName, lpPort, 0&, 0&, 0)
If (wSizeDM <> 0) Then
hMem = GlobalAlloc(GHND, wSizeDM)
If (hMem <> 0) Then
pDM = GlobalLock(hMem)
dummy = CallProc(lpfnMode, 0&, hDriver, pDM, lpName, lpPort, 0&, "WIN.INI", DM_COPY)
wFlags = DM_UPDATE Or DM_MODIFY
If UpdatePrt Then
wFlags = wFlags Or DM_PROMPT
End If
dummy = CallProc(lpfnMode, 0&, hDriver, 0&, lpName, lpPort, pDM, "WIN.INI", wFlags)
dummy = GlobalUnlock(hMem)
End If
End If
End If
FreeLibrary (hDriver)
End If
Screen.MousePointer = 0
End Sub
Sub Command1_Click ()
If List1.ListIndex >= 0 Then
AccessPrinter (False)
End If
Unload PrintSetup
End Sub
Sub Command1_KeyPress (KeyAscii As Integer)
kbDaemon (KeyAscii)
End Sub
Sub Command2_Click ()
Unload PrintSetup
End Sub
Sub Command2_KeyPress (KeyAscii As Integer)
kbDaemon (KeyAscii)
End Sub
Sub Command3_Click ()
AccessPrinter (True)
End Sub
Sub Command3_KeyPress (KeyAscii As Integer)
kbDaemon (KeyAscii)
End Sub
Sub Form_KeyPress (KeyAscii As Integer)
kbDaemon (KeyAscii)
End Sub
Sub Form_Load ()
lbsetup List1
End Sub
Sub kbDaemon (KeyAscii As Integer)
If KeyAscii = Asc("P") Or KeyAscii = Asc("p") Then
List1.GotFocus = True
End If
End Sub
Function lbLookup (c As Control, Key As String)
x% = c.ListCount - 1
For i% = 0 To x%
If (c.list(i%) = Key) Then
lbLookup = i%
Exit Function
End If
Next
lbLookup = -1
End Function
Function lbParse (SrcString As String, lpPrinter As String, lpPort As String, lpDriver As String) As Integer
'We assume that the input string is
'in the form: <Printer> on <Port>
Dim cBuff1 As String * SIZETEMPBUFF
Dim fstru As OFSTRUCT
i = Len(SrcString)
strlen = i
While (i > 0 And Mid$(SrcString, i, 1) <> " ")
i = i - 1
Wend
lpPort = Trim(Mid$(SrcString, i + 1, strlen - i))
lpPrinter = Trim$(Mid$(SrcString, 1, i - 3))
x = GetProfileString("devices", ByVal lpPrinter, ByVal 0&, cBuff1, SIZETEMPBUFF)
lpDriver = Trim(Mid$(cBuff1, 1, InStr(cBuff1, ",") - 1))
x = InStr(lpDriver, ".")
If x = 0 Then
lpDriver = lpDriver + ".Drv"
End If
x = OpenFile(lpDriver, fstru, OF_EXIST Or OF_READ)
If (x = -1) Then
lbParse = -1
Exit Function
End If
lbParse = 1
End Function
Sub lbsetup (lb As Control)
Dim cBuff1 As String * SIZETEMPBUFF
Dim lpKeyList As String * MAXKEYBUFFER
Dim Str1 As String
Dim i As Integer
Dim j As Integer
Dim lpKeyName As String
Dim DeviceName As String
StrIndex = 1
j = GetProfileString("Devices", ByVal 0&, "No Devices Available", lpKeyList, MAXKEYBUFFER)
While (StrIndex <= j)
NullPos = InStr(StrIndex, lpKeyList, Chr$(0))
lpKeyName = Mid$(lpKeyList, StrIndex, NullPos - StrIndex)
cBuff1 = String$(SIZETEMPBUFF, Chr$(0))
i = GetProfileString("Devices", ByVal lpKeyName, ByVal 0&, cBuff1, SIZETEMPBUFF)
'The string Returned should be in the form:
' PCL / HP LaserJet,HPPCL,LPT1:,LPT2:
'Get the device Name
x = InStr(1, cBuff1, ",") + 1
'Loop Through the devices adding a string to the listbox Control
Done = 0
While (Not Done)
NextComma = InStr(x, cBuff1, ",")
If NextComma = 0 Then
NextComma = i + 1
Done = -1
End If
Str1 = lpKeyName + " on " + Mid$(cBuff1, x, NextComma - x)
lb.AddItem Str1
x = NextComma + 1
Wend
StrIndex = NullPos + 1
Wend
'-------------------
'Get Default Printer
cBuff1 = String$(SIZETEMPBUFF, Chr$(0))
i = GetProfileString("Windows", "Device", ByVal 0&, cBuff1, SIZETEMPBUFF)
x = InStr(1, cBuff1, ",") + 1
NextComma = InStr(x, cBuff1, ",")
If NextComma = 0 Then